home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / oper_sys / weyl / weyl_lsp.lha / poly-tools.lisp < prev    next >
Lisp/Scheme  |  1991-10-04  |  5KB  |  139 lines
  1. ;;; -*- Mode:Lisp; Package:Weyli; Base:10; Lowercase:T; Syntax:Common-Lisp -*-
  2. ;;; ===========================================================================
  3. ;;;                  Polynomial Domain Tools
  4. ;;; ===========================================================================
  5. ;;; (c) Copyright 1989, 1991 Cornell University
  6.  
  7. ;;; $Id: poly-tools.lisp,v 2.13 1991/10/04 22:43:43 rz Exp $
  8.  
  9. (in-package "WEYLI")
  10.  
  11. (defmethod print-object ((d polynomial-ring) stream)
  12.   (with-slots (coefficient-domain) d
  13.     (format stream "~A[" coefficient-domain)
  14.     (display-list (ring-variables d) stream)
  15.     (princ "]" stream)))
  16.  
  17. (defmethod initialize-instance :after
  18.      ((domain variable-hash-table) &rest plist)
  19.   (declare (ignore plist))
  20.   (with-slots (variable-hash-table variable-table variables) domain
  21.     (setq variable-hash-table (make-hash-table :test #'equal))
  22.     (setq variable-table (make-array (list (max (length variables) 1) 2)))
  23.     (loop for var in variables
  24.       with i = 0
  25.       do (setf (gethash var variable-hash-table) i)
  26.          (setf (aref variable-table i 0) var)
  27.          (incf i))))
  28.  
  29. (defmethod variable-index ((domain variable-hash-table) 
  30.                (variable (or symbol list)))
  31.   (gethash (coerce variable *general*) (variable-hash-table domain)))
  32.  
  33. (defmethod variable-symbol ((domain variable-hash-table) (order-number number))
  34.   (aref (variable-index-table domain) order-number 0))
  35.  
  36. ;;(defmethod variable-symbol ((domain variable-hash-table) (poly polynomial))
  37. ;;  (aref (variable-index-table domain) (poly-order-number (poly-form poly)) 0))
  38.  
  39. (defmethod get-variable-number-property
  40.     ((domain variable-hash-table) order-number property)
  41.   (getf (aref (variable-index-table domain) order-number 1) property))
  42.  
  43. (defmethod set-variable-number-property
  44.        ((domain variable-hash-table) order-number property value)
  45.   (setf (getf (aref (variable-index-table domain) order-number 1) property)
  46.     value))
  47.  
  48. (defsetf get-variable-number-property set-variable-number-property)
  49.  
  50. (defmethod get-variable-property
  51.     ((domain variable-hash-table) variable property)
  52.   (setq variable (coerce variable *general*))
  53.   (get-variable-number-property domain (variable-index domain variable)
  54.                 property))
  55.  
  56. (defmethod set-variable-property
  57.     ((domain variable-hash-table) variable property value)  
  58.   (setq variable (coerce variable *general*))
  59.   (set-variable-number-property domain (variable-index domain variable)
  60.                 property value))
  61.  
  62. ;; Defined in general, which is loaded first.
  63. ;;(defsetf get-variable-property set-variable-property)
  64.  
  65. (defmethod add-new-variable ((ring variable-hash-table) variable)
  66.   (setq variable (coerce variable *general*))
  67.   (with-slots (variables variable-hash-table variable-table) ring
  68.     (unless (member variable variables :test #'ge-equal)
  69.       (let* ((count (length variables))
  70.          (array (make-array (list (1+ count) 2))))
  71.     (setq variables (append variables (list variable)))
  72.     (copy-array-contents variable-table array)
  73.     (setq variable-table array)
  74.     (setf (aref variable-table count 0) variable)
  75.     (setf (gethash variable variable-hash-table) count)
  76.     count))))
  77.  
  78. (defmethod initialize-instance :after ((domain single-variable-hash-table)
  79.                        &rest plist)
  80.   (declare (ignore plist))
  81.   (with-slots (variables variable) domain
  82.     (setq variables (list variable))))
  83.  
  84. (defmethod variable-index ((domain single-variable-hash-table)
  85.                (variable polynomial))
  86.   0)
  87.  
  88. (defmethod variable-index ((domain single-variable-hash-table)
  89.                (variable symbol))
  90.   0)
  91.  
  92. (defmethod variable-symbol ((domain single-variable-hash-table)
  93.                 (poly polynomial))
  94.   (cond ((eql (domain-of poly) domain)
  95.      (svht-variable domain))
  96.     (t (error "~S is not an element of ~S" poly domain))))
  97.  
  98. (defmethod variable-symbol ((domain single-variable-hash-table)
  99.                 (poly number))
  100.   (cond ((lisp:zerop poly)
  101.      (svht-variable domain))
  102.     (t (error "~D is not an index for an element of ~S" poly domain))))
  103.  
  104. (defmethod get-variable-number-property
  105.        ((domain single-variable-hash-table) order-number property)
  106.   (if (lisp:zerop order-number)
  107.       (getf (svht-variable-plist domain) property)
  108.       (error "Not the index of a variable")))
  109.  
  110. (defmethod set-variable-number-property
  111.        ((domain single-variable-hash-table) order-number property value)
  112.   (if (lisp:zerop order-number)
  113.       (setf (getf (svht-variable-plist domain) property)
  114.         value)
  115.       (error "Not the index of a variable")))
  116.  
  117. (defmethod get-variable-property ((domain single-variable-hash-table) variable property)
  118.   (if (eql variable (svht-variable domain))
  119.       (getf (svht-variable-plist domain) property)
  120.       (error "~S is not a variable of ~S" variable domain)))
  121.  
  122. (defmethod set-variable-property ((domain single-variable-hash-table) variable property value)
  123.   (if (eql variable (svht-variable domain))
  124.       (setf (getf (svht-variable-plist domain) property) value)
  125.       (error "~S is not a variable of ~S" variable domain)))
  126.  
  127. (defmethod add-new-variable ((ring single-variable-hash-table) variable)
  128.   (declare (ignore variable))
  129.   (error "Can't add a variable to univariate polynomial domain (FIXTHIS)"))
  130.  
  131.  
  132. (defmethod zero ((domain caching-zero-and-one))
  133.   (with-slots (zero) domain
  134.     zero))
  135.  
  136. (defmethod one ((domain caching-zero-and-one))
  137.   (with-slots (one) domain
  138.     one))
  139.